home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / System source / BasicStr < prev    next >
Encoding:
Text File  |  1994-06-03  |  1.9 KB  |  66 lines  |  [TEXT/YERK]
  1. \ basicStr - the primitive string class
  2. \  1/14/85  cbd Separated from string
  3. \  9/12/86  cdn Allow zero for addr1 and/or addr2 in replace:
  4. \ 12/04/88    rfl fixed add: using size: self
  5. \ 12/17/92    rfl    lock handle for printing
  6. \  5/13/93    rfl    restore original state after printing; added saving state to replace:
  7. \  6/03/94    rfl    added offset: method
  8.  
  9. Decimal
  10.  
  11. :CLASS  BasicStr  <Super Handle
  12.  
  13.     Var    offset
  14.  
  15.     \ this method returns the handle - replaces get: in super
  16.     :M  HANDLE:  get: super  ;M
  17.  
  18.     \ interface method to the Toolbox Munger utility - 1 replaced by 2
  19.     :M  REPLACE: { addr1 len1 addr2 len2 -- }  getState: self unlock: self
  20.         0 get: super get: offset dup 0< classErr" 151
  21.         addr1 dup IF +base THEN len1 addr2 dup IF +base THEN len2
  22.         $ a9e0 trap ( call Munger ) put: offset  setState: self ;M
  23.  
  24.     \ allocate the string on the heap
  25.     :M  NEW:  0 new: super  clear: offset  ;M
  26.  
  27.     \ set the string to the null string
  28.     :M  CLEAR:  0 setSize: self  clear: offset  ;M
  29.  
  30.     \ ( offs -- ) set new offset for string
  31.     :M  MOVETO:  size: self  min put: offset  ;M
  32.  
  33.     \ ( offs -- ) relative offset
  34.     :M  OFFSET: get: offset + moveto: self ;M
  35.  
  36.     \ ( -- addr len )  return the entire string
  37.     :M  GET:  ptr: self size: self  ;M
  38.  
  39.     \ ( -- addr len )  map string to upper case and get it
  40.     :M  UC:  get: self over +base over >uc   ;M
  41.  
  42.     \ ( addr len -- )  replace entire string with replacement string
  43.     :M  PUT: { addr len -- }   clear: offset
  44.         0 -1 addr len replace: self   ;M
  45.  
  46.     :M  INSERT:  { addr len -- }  addr 0 addr len  replace: self  ;M
  47.  
  48.     :M  ADD: { addr len -- }  size: self moveto: self
  49.         addr len  insert: self ;M
  50.  
  51.     \ ( char -- )  append a char to end of string
  52.     :M  +:  pad c! pad 1 add: self  ;M
  53.  
  54.     \ ( -- chr t OR f)  return char at offset and advance - false if at end
  55.     :M  NEXT:  get: offset size: self <
  56.         IF  get: offset ptr: self + c@ true 1 +: offset
  57.         ELSE  false
  58.         THEN   ;M
  59.  
  60.     \ ( -- )
  61.     :M  PRINT:  getState: self lock: self get:  self type setState: self ;M
  62.  
  63. ;CLASS
  64.  
  65. <" String
  66.